home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / clue.lha / clue / clos-patch.l next >
Lisp/Scheme  |  1989-07-12  |  4KB  |  157 lines
  1. ;;; -*- Mode:Lisp; Package:XLIB; Base:10; Lowercase:YES; Patch-file:T; Syntax:Common-Lisp -*-
  2.  
  3. ;;; This file integrates CLX with CLOS
  4.  
  5. ;;;
  6. ;;;             TEXAS INSTRUMENTS INCORPORATED
  7. ;;;                  P.O. BOX 2909
  8. ;;;                   AUSTIN, TEXAS 78769
  9. ;;;
  10. ;;; Copyright (C) 1987 Texas Instruments Incorporated.
  11. ;;;
  12. ;;; Permission is granted to any individual or institution to use, copy, modify,
  13. ;;; and distribute this software, provided that this complete copyright and
  14. ;;; permission notice is maintained, intact, in all copies and supporting
  15. ;;; documentation.
  16. ;;;
  17. ;;; Texas Instruments Incorporated provides this software "as is" without
  18. ;;; express or implied warranty.
  19. ;;;
  20.  
  21.  
  22. ;;; THIS FILE MUST BE LOADED IMMEDIATELY AFTER THE CLX/dependent.l FILE
  23. ;;; WHILE CLX IS BEING COMPILED.  IT RE-DEFINES DRAWABLE, WINDOW AND PIXMAP
  24. ;;; TO BE CLOS CLASSES.
  25.  
  26.  
  27. #+comment ;; This should work, but doesn't on Franz Lisp...
  28. (eval-when (compile load eval)
  29.   (cond ((find-package 'clos)
  30.      (in-package 'xlib :use '(lisp clos)))
  31.     ((find-package 'ticlos)
  32.      (in-package 'xlib :use '(lisp ticlos)))
  33.     ((find-package 'cluei) ;; must be using clos-kludge
  34.      (in-package 'cluei :use '(lisp xlib)))
  35.     (t (error "Can't find a CLOS")))
  36. )
  37. ;; Set the package with this cruft instead
  38. (eval-when (eval compile load)
  39.   (when (find-package 'pcl)
  40.     (pushnew :pcl  *features*)
  41.     (pushnew :clos *features*)))
  42. #+pcl
  43. (in-package 'xlib :use '(lisp pcl))
  44. #+(and clos (not explorer) (not pcl))
  45. (in-package 'xlib :use '(lisp clos))
  46. #+(and clos explorer (not pcl))
  47. (in-package 'xlib :use '(lisp ticlos))
  48. #-(or pcl clos)
  49. (in-package 'cluei :use '(lisp xlib))
  50.  
  51.  
  52. ;; Nuke defstruct info from drawable window and pixmap
  53. (eval-when (compile load eval)
  54.   (dolist (symbol '( drawable drawable-id drawable-display drawable-plist make-drawable drawable-p
  55.              window window-id window-display window-plist make-window window-p
  56.              pixmap pixmap-id pixmap-display pixmap-plist make-pixmap pixmap-p))
  57.     (setf (symbol-plist symbol) nil)
  58.     (fmakunbound symbol))
  59.   )
  60.  
  61. ;;
  62. ;; Drawables
  63. ;;
  64.  
  65. ;; Allow change in metaclass (structure-class to standard-class)
  66. (setf (find-class 'drawable nil) nil)
  67.  
  68. (defclass drawable ()
  69.   ((id      :type     resource-id
  70.         :initform 0
  71.         :accessor drawable-id
  72.         :initarg  :id)
  73.    
  74.    (display :type     (or null display)
  75.         :initform nil
  76.         :accessor drawable-display
  77.         :initarg  :display)
  78.    
  79.    (plist   :type     list
  80.         :initform nil
  81.         :accessor drawable-plist
  82.         :initarg  :plist))        ; Extension hook
  83.  
  84.   (:documentation "The class of CLX drawable objects."))
  85.  
  86.  
  87. (defun make-drawable (&rest initargs)
  88.   (apply #'make-instance 'drawable initargs))
  89.  
  90. (defun drawable-p (object)
  91.   (typep object 'drawable))
  92.  
  93. ;;
  94. ;; Windows
  95. ;;
  96.  
  97. ;; Allow change in metaclass (structure-class to standard-class)
  98. (setf (find-class 'window nil) nil)
  99.  
  100. (defclass window (drawable)
  101.   ((id      :type     resource-id
  102.         :initform 0
  103.         :accessor window-id
  104.         :initarg  :id)
  105.    
  106.    (display :type     (or null display)
  107.         :initform nil
  108.         :accessor window-display
  109.         :initarg  :display)
  110.    
  111.    (plist   :type     list
  112.         :initform nil
  113.         :accessor window-plist
  114.         :initarg  :plist))        ; Extension hook
  115.  
  116.   (:documentation "The class of CLX window objects."))
  117.  
  118.  
  119. (defun make-window (&rest initargs)
  120.   (apply #'make-instance 'window initargs))
  121.  
  122. (defun window-p (object)
  123.   (typep object 'window))
  124.  
  125.  
  126. ;;
  127. ;; Pixmaps
  128. ;;
  129.  
  130. ;; Allow change in metaclass (structure-class to standard-class)
  131. (setf (find-class 'pixmap nil) nil)
  132.  
  133. (defclass pixmap (drawable)
  134.   ((id      :type     resource-id
  135.         :initform 0
  136.         :accessor pixmap-id
  137.         :initarg  :id)
  138.    
  139.    (display :type     (or null display)
  140.         :initform nil
  141.         :accessor pixmap-display
  142.         :initarg  :display)
  143.    
  144.    (plist   :type     list
  145.         :initform nil
  146.         :accessor pixmap-plist
  147.         :initarg  :plist))        ; Extension hook
  148.  
  149.   (:documentation "The class of CLX pixmap objects."))
  150.  
  151.  
  152. (defun make-pixmap (&rest initargs)
  153.   (apply #'make-instance 'pixmap initargs))
  154.  
  155. (defun pixmap-p (object)
  156.   (typep object 'pixmap))
  157.